home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue29 / web / FREQUEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-07-16  |  4.5 KB  |  155 lines
  1. unit frequest;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, HTTPApp, HelloProducer,
  7.   FieldsProducer;
  8.  
  9. type
  10.   TWebModule1 = class(TWebModule)
  11.     PageProducer1: TPageProducer;
  12.     procedure WebModule1WebActionItem1Action(Sender: TObject;
  13.       Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  14.     procedure PageProducer1HTMLTag(Sender: TObject; Tag: TTag;
  15.       const TagString: String; TagParams: TStrings;
  16.       var ReplaceText: String);
  17.   private
  18.     { Private declarations }
  19.   public
  20.     { Public declarations }
  21.   end;
  22.  
  23. var
  24.   WebModule1: TWebModule1;
  25.  
  26. implementation
  27.  
  28. uses TypInfo;
  29. {$R *.DFM}
  30.  
  31. procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;
  32.   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  33. begin
  34.   Response.Content := PageProducer1.Content;
  35. end;
  36.  
  37. procedure TWebModule1.PageProducer1HTMLTag(Sender: TObject; Tag: TTag;
  38.   const TagString: String; TagParams: TStrings; var ReplaceText: String);
  39. var i: integer;
  40. begin
  41.   with TPageProducer(Sender).Dispatcher.Request do
  42.   if CompareText(TagString, 'METHODTYPE') = 0 then
  43.     ReplaceText := TypInfo.GetEnumName(TypeInfo(TMethodType), Ord(MethodType))
  44.   else
  45.   if CompareText(TagString, 'CONTENTFIELDS') = 0 then
  46.   begin
  47.     ReplaceText := ReplaceText + '<UL>';
  48.     for i := 0 to ContentFields.Count - 1 do
  49.       ReplaceText := ReplaceText + '<LI>' + ContentFields[i];
  50.     ReplaceText := ReplaceText + '</UL>';
  51.   end
  52.   else
  53.   if CompareText(TagString, 'COOKIEFIELDS') = 0 then
  54.   begin
  55.     ReplaceText := ReplaceText + '<UL>';
  56.     for i := 0 to CookieFields.Count - 1 do
  57.       ReplaceText := ReplaceText + '<LI>' + CookieFields[i];
  58.     ReplaceText := ReplaceText + '</UL>';
  59.   end
  60.   else
  61.   if CompareText(TagString, 'QUERYFIELDS') = 0 then
  62.   begin
  63.     ReplaceText := ReplaceText + '<UL>';
  64.     for i := 0 to QueryFields.Count - 1 do
  65.       ReplaceText := ReplaceText + '<LI>' + QueryFields[i];
  66.     ReplaceText := ReplaceText + '</UL>';
  67.   end
  68.   else
  69.   if CompareText(TagString, 'METHOD') = 0 then
  70.     ReplaceText := Method
  71.   else
  72.   if CompareText(TagString, 'PROTOCOLVER') = 0 then
  73.     ReplaceText := ProtocolVersion
  74.   else
  75.   if CompareText(TagString, 'URL') = 0 then
  76.     ReplaceText := URL
  77.   else
  78.   if CompareText(TagString, 'QUERY') = 0 then
  79.     ReplaceText := Query
  80.   else
  81.   if CompareText(TagString, 'PATHINFO') = 0 then
  82.     ReplaceText := PathInfo
  83.   else
  84.   if CompareText(TagString, 'PATHTRANSLATED') = 0 then
  85.     ReplaceText := PathTranslated
  86.   else
  87.   if CompareText(TagString, 'AUTHORIZATION') = 0 then
  88.     ReplaceText := Authorization
  89.   else
  90.   if CompareText(TagString, 'CACHECONTROL') = 0 then
  91.     ReplaceText := CacheControl
  92.   else
  93.   if CompareText(TagString, 'COOKIES') = 0 then
  94.     ReplaceText := Cookie
  95.   else
  96.   if CompareText(TagString, 'ACCEPT') = 0 then
  97.     ReplaceText := Accept
  98.   else
  99.   if CompareText(TagString, 'FROM') = 0 then
  100.     ReplaceText := From
  101.   else
  102.   if CompareText(TagString, 'HOST') = 0 then
  103.     ReplaceText := Host
  104.   else
  105.   if CompareText(TagString, 'IFMODIFIEDSINCE') = 0 then
  106.     ReplaceText := DateTimeToStr(IfModifiedSince)
  107.   else
  108.   if CompareText(TagString, 'REFERER') = 0 then
  109.     ReplaceText := Referer
  110.   else
  111.   if CompareText(TagString, 'USERAGENT') = 0 then
  112.     ReplaceText := UserAgent
  113.   else
  114.   if CompareText(TagString, 'COTENTENCODING') = 0 then
  115.     ReplaceText := ContentEncoding
  116.   else
  117.   if CompareText(TagString, 'CONTENTTYPE') = 0 then
  118.     ReplaceText := ContentType
  119.   else
  120.   if CompareText(TagString, 'CONTENTLENGTH') = 0 then
  121.     ReplaceText := IntToStr(ContentLength)
  122.   else
  123.   if CompareText(TagString, 'CONTENTVERSION') = 0 then
  124.     ReplaceText := ContentVersion
  125.   else
  126.   if CompareText(TagString, 'CONTENT') = 0 then
  127.     ReplaceText := Content
  128.   else
  129.   if CompareText(TagString, 'CONNECTION') = 0 then
  130.     ReplaceText := Connection
  131.   else
  132.   if CompareText(TagString, 'DERIVEDFROM') = 0 then
  133.     ReplaceText := DerivedFrom
  134.   else
  135.   if CompareText(TagString, 'EXPIRES') = 0 then
  136.     ReplaceText := DateTimeToStr(Expires)
  137.   else
  138.   if CompareText(TagString, 'TITLE') = 0 then
  139.     ReplaceText := Title
  140.   else
  141.   if CompareText(TagString, 'REMOTEADDR') = 0 then
  142.     ReplaceText := RemoteAddr
  143.   else
  144.   if CompareText(TagString, 'REMOTEHOST') = 0 then
  145.     ReplaceText := RemoteHost
  146.   else
  147.   if CompareText(TagString, 'SCRIPTNAME') = 0 then
  148.     ReplaceText := ScriptName
  149.   else
  150.   if CompareText(TagString, 'SERVERPORT') = 0 then
  151.     ReplaceText := IntToStr(ServerPort);
  152. end;
  153.  
  154. end.
  155.